home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Menus / frontierMenu.tcl < prev    next >
Encoding:
Text File  |  1997-12-08  |  21.7 KB  |  794 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Frontier menu - tools for using Alpha as Frontier's external editor
  4.  # 
  5.  #  FILE: "frontierMenu.tcl"
  6.  #                                    created: 97-04-03 22.01.22 
  7.  #                                last update: 97-11-02 22.41.03 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.1
  13.  # 
  14.  # Copyright 1997 by Johan Linde
  15.  #  
  16.  # Much of the tcl code and the Frontier scripts have been written by 
  17.  # Danis Georgiadis <dmg@hyper.gr>
  18.  # 
  19.  # This software may be used freely, and distributed freely, as long as the 
  20.  # receiver is not obligated in any way by receiving it.
  21.  #  
  22.  # If you make improvements to this file, please share them!
  23.  # 
  24.  # ###################################################################
  25.  ##
  26.  
  27.  
  28. alpha::menu frontierMenu 2.1.1 "•142" in_menu {
  29.     set frontierScriptMenu •144
  30. } uninstall {
  31.     removeFile $pkg_file
  32.     removeFile "$HOME:Help:Frontier Help"
  33. } maintainer {
  34.     "Johan Linde" jl@theophys.kth.se <http://www.theophys.kth.se/~jl/Alpha.html>
  35. } help {file "Frontier Help"}
  36.  
  37. proc frontierMenu {} {}
  38.  
  39.  
  40. # Preferences
  41. newPref f autoLaunch 0 Fron
  42. newPref v BrowsePoints {{root root} {Websites user.websites}} Fron
  43. newPref v OpenPoints {{Websites user.websites} {Glossary user.html.glossary} {Templates user.html.templates}} Fron
  44.  
  45. # Register hooks
  46. hook::register closeHook frontierCloseHook
  47. hook::register savePostHook frontierSavePostHook
  48. hook::register saveasHook frontierSaveasHook
  49.  
  50.  
  51. proc frontierBrowseMenu {} {
  52.     global FronmodeVars
  53.     set bl {}
  54.     foreach b $FronmodeVars(BrowsePoints) {
  55.         lappend bl [lindex $b 0]
  56.     }
  57.     return [list menu -n Browse -p frontierMenuProc -m [concat $bl [list "(-" "Browse at…" Add… Remove…]]]
  58. }
  59.  
  60. proc frontierOpenMenu {} {
  61.     global FronmodeVars
  62.     set bl {}
  63.     foreach b $FronmodeVars(OpenPoints) {
  64.         lappend bl [lindex $b 0]
  65.     }
  66.     return [list menu -n Open -p frontierMenuProc -m [concat $bl [list "(-" "Open…" Add… Remove…]]]
  67. }
  68.  
  69. # Menu definition
  70. menu -n $frontierMenu -p frontierMenuProc -m [list \
  71.     "<U<O/FSwitch to Frontier" \
  72.     "<U<O/'View in Browser" \
  73.     "<I<O/YFrontier Shell" \
  74.     [frontierBrowseMenu] \
  75.     [frontierOpenMenu] \
  76.     "Rebuild Scripts Menu" \
  77.     Preferences…]
  78.  
  79. proc frontierMenuProc {menu item} {
  80.     global frontierMenu FronmodeVars
  81.     switch -glob $menu {
  82.         •* {
  83.             switch $item {
  84.                 "Switch to Frontier" {app::launchFore LAND}
  85.                 Preferences {FronmodifyFlags}
  86.                 default {eval frontier[join $item ""]}
  87.             }
  88.         }
  89.         Browse {
  90.             switch $item {
  91.                 "Browse at" {frontierBrowseAt}
  92.                 Add {frontierAddPoint Browse}
  93.                 Remove {frontierRemovePoint Browse}
  94.                 default {
  95.                     foreach b $FronmodeVars(BrowsePoints) {
  96.                         if {[lindex $b 0] == $item} {
  97.                             odbBrowse [lindex $b 1]
  98.                             break
  99.                         }
  100.                     }
  101.                 }
  102.             }
  103.         }
  104.         Open {
  105.             switch $item {
  106.                 Open {frontierOpen}
  107.                 Add {frontierAddPoint Open}
  108.                 Remove {frontierRemovePoint Open}
  109.                 default {
  110.                     foreach b $FronmodeVars(OpenPoints) {
  111.                         if {[lindex $b 0] == $item} {
  112.                             frontierDoScript "edit (@[lindex $b 1])" front
  113.                             break
  114.                         }
  115.                     }
  116.                 }
  117.             }
  118.         }
  119.     }
  120. }
  121.  
  122.  
  123. # Called by Frontier when opening a Frontier text document in Alpha.
  124. proc openFromFrontier {} {
  125.     global frontierWinList win::Modes
  126.     set name [lindex [winNames -f] 0]
  127.     set name0 [stripNameCount $name]
  128.     regsub -all {\[|\]} $name0 {\\&} name0
  129.     if {[lsearch -exact $frontierWinList $name0] < 0} {lappend frontierWinList $name0}
  130. }
  131.  
  132. # If the current document is a Frontier document, it is updated in Frontier.
  133. proc frontierSavePostHook {name} {
  134.     global frontierWinList
  135.     if {[lsearch -exact $frontierWinList $name] >= 0} {
  136.         app::launchBack LAND
  137.         regsub -all {\\([][])} $name {\1} name
  138.         AEBuild 'LAND' ALFA FMod "----" "“${name}”"
  139.     }
  140. }
  141.  
  142.  
  143. # A list of windows opened from Frontier.
  144. if {![info exists frontierWinList]} {set frontierWinList {}}
  145.  
  146. # Executes a script in Frontier.
  147. proc frontierDoScript {script {front 0} {alert 1}} {
  148.     app::launchBack LAND
  149.     if {[catch {dosc -c 'LAND' -s $script} returnvalue]} {
  150.         if {$alert} {
  151.             alertnote "Frontier $returnvalue"
  152.             error "Frontier $returnvalue"
  153.         }
  154.         error $returnvalue
  155.     } elseif {$front == "front"} {
  156.         switchTo 'LAND'
  157.     }
  158.     return $returnvalue
  159. }
  160.  
  161. # Executes one of the scripts in Frontier, which are required to use Alpha with Frontier.
  162. proc frontierDoAlphaScript {script} {
  163.     global HOME frontierHasWarned
  164.     if {[catch {frontierDoScript $script 0 0} res]} {
  165.         if {![info exists frontierHasWarned]} {
  166.             alertnote "The Frontier verbs required to integrate Alpha and Frontier have not been\
  167.               properly installed. See the file 'Frontier Help.'"
  168.             edit -r -c "$HOME:Help:Frontier Help"
  169.         }
  170.         error $res
  171.     }
  172.     return $res
  173. }
  174.  
  175.  
  176. # closeHook
  177. # If the window to be closed is a Frontier document, it is removed
  178. # from Frontier's list of open external documents.
  179. proc frontierCloseHook {name} {
  180.     global frontierWinList frontierQSWin frontierCommandHistory frontierCommandNum
  181.     if {[set where [lsearch -exact $frontierWinList $name]] >= 0} {
  182.         regsub -all {\\([][])} $name {\1} name
  183.         set frontierWinList [lreplace $frontierWinList $where $where]
  184.         catch {AEBuild 'LAND' ALFA FCls "----" "“${name}”"}
  185.     }
  186.     if {$name == $frontierQSWin} {set frontierCommandHistory ""; set frontierCommandNum 0}
  187. }
  188.  
  189. # saveasHook
  190. proc frontierSaveasHook {oldname newname} {
  191.     global frontierWinList
  192.     # Modify the Frontier win list if it's a Frontier window,
  193.     # and notify Frontier about it.
  194.     if {[set where [lsearch -exact $frontierWinList $oldname]] >= 0} {
  195.         set frontierWinList [lreplace $frontierWinList $where $where $newname]
  196.         app::launchBack LAND
  197.         AEBuild 'LAND' ALFA FMod "----" "“${oldname}”" zzzz "“${newname}”"
  198.     }
  199. }
  200.  
  201.  
  202. # Does the same as 'View in Browser' in Frontier's web menu.
  203. proc frontierViewinBrowser {} {
  204.     global frontierWinList
  205.     if {![llength [winNames]]} {
  206.         alertnote "No window!"
  207.         return
  208.     }
  209.     if {[lsearch $frontierWinList [set name [stripNameCount [lindex [winNames -f] 0]]]] >= 0} {
  210.         if {[winDirty]} {
  211.             if {[set ask [askyesno -c "Save '[file tail $name]'?"]] == "yes"} {
  212.                 save
  213.             } elseif {$ask == "cancel"} {
  214.                 return
  215.             }
  216.         }
  217.         frontierDoAlphaScript "Alpha.viewInBrowser(\"$name\")"
  218.     } else {
  219.         alertnote "Not a Frontier window."
  220.     }
  221. }
  222.  
  223. # Open a window in Frontier
  224. proc frontierOpen {} {
  225.     if {![catch {frontierGetAddress} addr]} {
  226.         frontierDoScript "edit (@$addr)" front
  227.     }
  228. }
  229.  
  230. # Browse a table in Frontier
  231. proc frontierBrowseAt {} {
  232.     if {![catch {frontierGetAddress} addr]} {
  233.         odbBrowse $addr
  234.     }
  235. }
  236.  
  237. # Add to Browse and Open submenus
  238. proc frontierAddPoint {type} {
  239.     global FronmodeVars modifiedModeVars
  240.     set values ""
  241.     while {1} {
  242.         set values [dialog -w 450 -h 130 -t "Add $type menu item" 30 10 290 30 \
  243.             -t "Location in database:" 10 40 160 60 -e [lindex $values 0] 165 40 440 55 \
  244.             -t "Menu text:" 78 70 160 90 -e [lindex $values 1] 165 70 440 85 \
  245.             -b OK 20 100 85 120 -b Cancel 105 100 170 120]
  246.         if {[lindex $values 3]} {return}
  247.         set addr [string trim [lindex $values 0]]
  248.         if {$addr == ""} {alertnote "Location is database must be specified."; continue}
  249.         set text [string trim [lindex $values 1]]
  250.         if {$text == ""} {alertnote "The menu item must be specified."; continue}
  251.         if {[frontierDoScript "defined($addr)"] == "true"} {
  252.             set ex 0
  253.             foreach b $FronmodeVars(${type}Points) {
  254.                 if {[lindex $b 0] == $text} {alertnote "A menu item '$text' already exists."; set ex 1}
  255.             }
  256.             if {!$ex} {break}
  257.         } else {
  258.             alertnote "“$addr” is not a valid database address."
  259.         }
  260.     }
  261.     lappend FronmodeVars(${type}Points) [list $text $addr]
  262.     lappend modifiedModeVars [list ${type}Points FronmodeVars]
  263.     eval [eval frontier${type}Menu]
  264. }
  265.  
  266. # Remove from Browse and Open submenus.
  267. proc frontierRemovePoint {type} {
  268.     global FronmodeVars modifiedModeVars
  269.     set points {}
  270.     foreach b $FronmodeVars(${type}Points) {
  271.         lappend points [lindex $b 0]
  272.         set pointat([lindex $b 0]) [lindex $b 1]
  273.     }
  274.     if {![llength $points] || [catch {listpick -p "Select [string tolower $type] point to remove:" -l $points} points] ||
  275.         ![llength $points]} {return}
  276.     set points [lindex $points 0]
  277.     if {[askyesno "'$points' points to '$pointat($points)'. Remove?"] != "yes"} {return}
  278.     set n {}
  279.     foreach b $FronmodeVars(${type}Points) {
  280.         if {[lindex $b 0] != $points} {lappend n $b}
  281.     }
  282.     set FronmodeVars(${type}Points) $n
  283.     lappend modifiedModeVars [list ${type}Points FronmodeVars]
  284.     eval [eval frontier${type}Menu]
  285. }
  286.  
  287. proc frontierGetAddress {} {
  288.     while {1} {
  289.         if {[catch {set addr [prompt "Location in Frontier database:" ""]}]} {
  290.             error ""
  291.         } else {
  292.             set addr [string trimleft [string trim $addr] {@}]
  293.             switch [frontierDoScript "defined($addr)"] {
  294.                 "true"        {return $addr}
  295.                 "false"        {alertnote "“$addr” is not a valid database address"}
  296.                 ""            {error ""}
  297.             }
  298.         }
  299.     }
  300. }
  301.  
  302. proc FronmodifyFlags {} {
  303.     global FronmodeVars modifiedModeVars
  304.     set values [dialog -w 300 -h 110 -t "Frontier Preferences" 30 10 290 30 \
  305.         -c "Launch Frontier at startup" $FronmodeVars(autoLaunch) 10 40 290 60 \
  306.         -b OK 20 80 85 100 -b Cancel 105 80 170 100]
  307.     if {[lindex $values 2]} {return}
  308.     set i -1
  309.     foreach flag [list autoLaunch] {
  310.         global $flag
  311.         incr i
  312.         set val [lindex $values $i]
  313.         if {$FronmodeVars($flag) != $val} {
  314.             set $flag $val
  315.             set FronmodeVars($flag) $val
  316.             lappend modifiedModeVars [list $flag FronmodeVars]
  317.         }
  318.     }
  319. }
  320.  
  321. proc OdbmodifyFlags {} {
  322.     FronmodifyFlags
  323. }
  324.  
  325. proc frontierGetWin {} {
  326.     global frontierWinList frontierWinNum
  327.     if {![info exists frontierWinNum]} {set frontierWinNum 0}
  328.     if {[llength $frontierWinList] == $frontierWinNum} {
  329.         unset frontierWinNum
  330.         return ""
  331.     } else {
  332.         return [lindex $frontierWinList [expr [incr frontierWinNum] - 1]]
  333.     }
  334. }
  335.  
  336. proc frontierCloseAllWindows {} {
  337.     global frontierWinList
  338.     foreach win $frontierWinList {
  339.         regsub -all {\\([][])} $win {\1} win
  340.         bringToFront $win
  341.         setWinInfo dirty 0
  342.         killWindow
  343.     }
  344. }
  345.  
  346. #===============================================================================
  347. # Script menu
  348. # 
  349. # The code to extract a Frontier menu has been written by
  350. # Danis Georgiadis <dmg@hyper.gr>
  351. # 
  352. #===============================================================================
  353.  
  354. proc setFrontierMenuScript {menu item scpt} {
  355.     global frontierMenuScripts
  356.     if {[regexp {&$} $item]} {
  357.         set item [string trimright $item &]
  358.     } else {
  359.         regsub -all {<[BUISEO]} $item "" item
  360.         regsub {/[a-zA-Z]} $item "" item
  361.         regsub -all {[!\^].} $item "" item
  362.     }
  363.     set key [string trimright "$menu$item" …]
  364.     set frontierMenuScripts($key) $scpt
  365. }
  366.  
  367. proc frontierBuildScriptMenu {} {
  368.     global frontierScriptMenu FronmodeVars
  369.  
  370.     set running 0
  371.     foreach    p [processes] {
  372.         if {[lindex $p 1] == "LAND" } {
  373.             set running 1
  374.         }
  375.     }
  376.     if {!$running} {
  377.         if {$FronmodeVars(autoLaunch)} {
  378.             app::launchBack LAND
  379.         } else {
  380.             return
  381.         }
  382.     }
  383.     set sfina [frontierDoAlphaScript "Alpha.getMenuSource()"]
  384.      set ptext [frontierDoAlphaScript "Alpha.getDefsSource()"]
  385.     
  386.     set mtext [list menu -m -n $frontierScriptMenu -p frontierScriptMenuProc $sfina]
  387.     eval $mtext
  388.     eval $ptext
  389.     
  390.     insertMenu $frontierScriptMenu
  391.  
  392. }
  393.  
  394. proc frontierScriptMenuProc {menu item} {
  395.     global frontierMenuScripts frontierScriptMenu
  396.     if {$menu == $frontierScriptMenu} {set menu ""}
  397.     set key "$menu$item"
  398.     frontierDoScript $frontierMenuScripts($key)
  399. }
  400.  
  401. proc frontierRebuildScriptsMenu {} {
  402.     global frontierMenuScripts
  403.     app::launchBack LAND
  404.     frontierDoAlphaScript "Alpha.invalMenuSources()"
  405.     catch {unset frontierMenuScripts}
  406.     frontierBuildScriptMenu
  407. }
  408.  
  409.  
  410. #===============================================================================
  411. #
  412. # Frontier shell
  413. # 
  414. # Some ideas taken from Matlab mode by Stephen Merkowitz
  415. # 
  416. #===============================================================================
  417. set frontierQSWin "* Frontier shell *"
  418. set frontierCommandHistory ""
  419. set frontierCommandNum 0
  420.  
  421. proc frontierFrontierShell {} {
  422.     global frontierQSWin
  423.     
  424.     if {[lsearch [winNames] $frontierQSWin] >= 0} {
  425.         bringToFront $frontierQSWin
  426.     } else {
  427.         new -n $frontierQSWin -m Fron
  428.         setWinInfo -w $frontierQSWin shell 1
  429.         insertText "Welcome to Alpha's Frontier shell\r«» "
  430.     }
  431. }
  432.  
  433.  
  434. proc frontierRunQuickScript {} {
  435.     global frontierCommandHistory frontierCommandNum frontierQSWin
  436.     set pos [getPos]
  437.  
  438.     set ind [string first "«» " [getText [lineStart $pos] [nextLineStart [getPos]]]]
  439.     if {$ind >= 0} {
  440.         set lStart [expr [lineStart $pos]+$ind+2]
  441.         endOfLine
  442.         set scriptName [getText $lStart [getPos]]
  443.         if {[getPos] != [maxPos]} {
  444.             goto [maxPos]
  445.             insertText $scriptName
  446.         }
  447.         
  448.         catch {frontierDoScript $scriptName 0 0} result
  449.         if {[string compare [lindex $frontierCommandHistory [expr [llength $frontierCommandHistory]-1]] $scriptName] != 0} {
  450.             lappend frontierCommandHistory $scriptName
  451.             if {[llength $frontierCommandHistory] > 30} {
  452.                 set frontierCommandHistory [lrange $frontierCommandHistory 1 end]
  453.             }
  454.         }
  455.         set frontierCommandNum [llength $frontierCommandHistory]
  456.         if {[string length $result]} {
  457.             insertText -w $frontierQSWin "\r" $result \r "«» "
  458.         } else {
  459.             insertText -w $frontierQSWin \r "«» "
  460.         }
  461.     } else {
  462.            if {[getPos] == [maxPos]} {
  463.             insertText "«» "
  464.         } else {
  465.             bind::CarriageReturn
  466.         }
  467.     }
  468.     return
  469. }
  470.  
  471.  
  472. proc frontierPrevCommand {} {
  473.     global frontierCommandHistory frontierCommandNum
  474.     
  475.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  476.     if {[set ind [string first "«» " $text]] == 0} {
  477.         goto [expr [lineStart [getPos]] + $ind + 2]
  478.     } else return
  479.  
  480.     incr frontierCommandNum -1
  481.     if {$frontierCommandNum < 0} {
  482.         incr frontierCommandNum
  483.         endOfLine
  484.         return
  485.     }
  486.     set text [lindex $frontierCommandHistory $frontierCommandNum]
  487.     set to [nextLineStart [getPos]]
  488.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  489.     replaceText [getPos] $to $text
  490. }
  491.  
  492.  
  493. proc frontierNextCommand {} {
  494.     global frontierCommandHistory frontierCommandNum
  495.     
  496.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  497.     if {[set ind [string first "«» " $text]] == 0} {
  498.         goto [expr [lineStart [getPos]] + $ind + 2]
  499.     } else return
  500.  
  501.     incr frontierCommandNum
  502.     if {$frontierCommandNum >= [llength $frontierCommandHistory]} {
  503.         incr frontierCommandNum -1
  504.         frontierCancelLine
  505.         return
  506.     }
  507.     set text [lindex $frontierCommandHistory $frontierCommandNum]
  508.     set to [nextLineStart [getPos]]
  509.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  510.     replaceText [getPos] $to $text
  511. }
  512.  
  513. proc frontierCancelLine {} {
  514.     global frontierCommandHistory frontierCommandNum
  515.  
  516.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  517.     if {[set ind [string first "«» " $text]] == 0} {
  518.         goto [expr [lineStart [getPos]] + $ind + 3]
  519.     } else return
  520.     
  521.     set to [nextLineStart [getPos]]
  522.     deleteText [getPos] $to
  523.     
  524.     set frontierCommandNum [llength $frontierCommandHistory]
  525. }
  526.  
  527. proc frontierBol {} {
  528.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  529.     if {[set ind [string first "«» " $text]] == 0} {
  530.         goto [expr [lineStart [getPos]] + $ind + 3]
  531.     } else {
  532.         goto [lineStart [getPos]]
  533.     }
  534. }
  535.  
  536.  
  537. regModeKeywords -m {«} Fron {}
  538. bind up <z> frontierPrevCommand Fron
  539. bind down <z> frontierNextCommand Fron
  540. bind '\r' frontierRunQuickScript Fron
  541. bind 'u'  <z>  frontierCancelLine  Fron
  542. bind left <c> frontierBol Fron
  543.  
  544. #===============================================================================
  545. # Odb browser
  546. # 
  547. # Written by Danis Georgiadis <dmg@hyper.gr> and modified by me to be integrated 
  548. # with the rest.
  549. # 
  550. #===============================================================================
  551.  
  552. set odbBrowserTabLength 3
  553. set odbBrowserTypeOffset 60
  554.  
  555. proc odbget120Spaces {} {
  556.     set spaces40 "                                        "
  557.     return "$spaces40$spaces40$spaces40"
  558. }
  559.  
  560. proc odbGetIndLevel {indStr} {
  561.     global odbBrowserTabLength
  562.     return [expr [string length $indStr] / $odbBrowserTabLength]
  563. }
  564.  
  565. proc odbGetIndString {indLevel} {
  566.     global odbBrowserTabLength
  567.     return [string range [odbget120Spaces] 0 [expr [expr $indLevel * $odbBrowserTabLength] - 1]]
  568. }
  569.  
  570. proc odbGetNextIndString {thisIndStr} {
  571.     return [odbGetIndString [expr [odbGetIndLevel $thisIndStr] + 1]]
  572. }
  573.  
  574. proc odbBrowseGetLineParts {name type addr level} {
  575.     global odbBrowserTypeOffset
  576.     global odbBrowserTabLength
  577.     
  578.     set indPadPart [odbGetIndString $level]
  579.     set namePart [string trim $name "\t "]
  580.     set typePadSize [expr $odbBrowserTypeOffset - [expr [string length $indPadPart] + [string length $name]]]
  581.     set typePadPart [string range [odbget120Spaces] 0 [expr $typePadSize - 1]]
  582.     set typePart "◊$type◊"
  583.     set addrPart "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$addr∞"
  584.     
  585.     set res ""
  586.     lappend res $indPadPart $namePart $typePadPart $typePart $addrPart
  587.     
  588.     return $res
  589. }
  590.  
  591. proc odbBrowseDown {} {
  592.     set curPos [getPos]
  593.     set curLineStart [lineStart $curPos]
  594.     set curLineEnd [nextLineStart $curPos]
  595.     select $curLineStart $curLineEnd
  596.     
  597.     set newLineStart [nextLineStart $curLineStart]
  598.     set newLineEnd [nextLineStart $newLineStart]
  599.     if {$newLineStart < [maxPos]} {
  600.         select $newLineStart $newLineEnd
  601.     }
  602. }
  603.  
  604. proc odbBrowseCmdDown {{option 0}} {
  605.     set curPos [getPos]
  606.     set curLineStart [lineStart $curPos]
  607.     set curLineEnd [nextLineStart $curPos]
  608.     
  609.     if {[regexp {^( *).+◊tabl◊\t+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind addr]} {
  610.         if {$option} {killWindow}
  611.         odbBrowse $addr
  612.     }
  613. }
  614.  
  615. proc odbBrowseUp {} {
  616.     set curPos [getPos]
  617.     set curLineStart [lineStart $curPos]
  618.     set curLineEnd [nextLineStart $curPos]
  619.     select $curLineStart $curLineEnd
  620.     
  621.     set newLineStart [prevLineStart $curLineStart]
  622.     set newLineEnd [nextLineStart $newLineStart]
  623.     if {$newLineEnd > 0} {
  624.         select $newLineStart $newLineEnd
  625.     }
  626. }
  627.  
  628. proc odbBrowseCmdUp {{option 0}} {
  629.     regexp {∞(.+)∞} [getText 0 [nextLineStart 0]] junk addr
  630.     if {[set point [string last "." $addr]] >= 0} {
  631.         if {$option} {killWindow}
  632.         odbBrowse [string range $addr 0 [expr $point - 1]]
  633.     }
  634. }
  635.  
  636. proc odbBrowserAddCells {pos cells indLevel} {
  637.     
  638.     set tmp ""
  639.     set colorCodes ""
  640.     set lastPos $pos
  641.     
  642.     foreach cell $cells {
  643.         set cellName [lindex $cell 0]
  644.         set cellType [lindex $cell 1]
  645.         set cellAddr [lindex $cell 2]
  646.         
  647.         set parts [odbBrowseGetLineParts $cellName $cellType $cellAddr $indLevel]
  648.         
  649.         set indPart [lindex $parts 0]
  650.         set namePart [lindex $parts 1]
  651.         set typePartPad [lindex $parts 2]
  652.         set typePart [lindex $parts 3]
  653.         set addrPart [lindex $parts 4]
  654.         
  655.         set nameStart [expr $lastPos + [string length $indPart]]
  656.         set nameEnd [expr $nameStart + [string length $namePart]]
  657.         
  658.         if {$cellType == "TEXT" || $cellType == "wptx"} {
  659.             lappend colorCodes [concat $nameStart 3]
  660.             lappend colorCodes [concat $nameEnd 0]
  661.         } elseif {$cellType == "tabl"} {
  662.             lappend colorCodes [concat $nameStart 5]
  663.             lappend colorCodes [concat $nameEnd 0]
  664.         } else {
  665.             lappend colorCodes [concat $nameStart 1]
  666.             lappend colorCodes [concat $nameEnd 0]
  667.         }
  668.         
  669.         set typeStart [expr $lastPos + [string length $indPart] + [string length $namePart] + [string length $typePartPad]]
  670.         set typeEnd [expr $typeStart + [string length $typePart]]
  671.         lappend colorCodes [concat $typeStart 4]
  672.         lappend colorCodes [concat $typeEnd 0]
  673.         
  674.         set line ""
  675.         append line $indPart $namePart $typePartPad $typePart $addrPart "\n"
  676.         append tmp $line
  677.         
  678.         set lastPos [expr $lastPos + [string length $line]]
  679.     }
  680.     
  681.     select $pos $pos
  682.     setWinInfo read-only 0
  683.     
  684.     insertText $tmp
  685.     
  686.     foreach colorCode $colorCodes {
  687.         insertColorEscape [lindex $colorCode 0] [lindex $colorCode 1]
  688.     }
  689.     
  690.     setWinInfo dirty 0
  691.     setWinInfo read-only 1
  692.     eval sizeWin [lrange [getGeometry] 2 end]
  693. }
  694.  
  695. proc odbBrowseRight {} {
  696.     set curPos [getPos]
  697.     set curLineStart [lineStart $curPos]
  698.     set curLineEnd [nextLineStart $curPos]
  699.     
  700.     if {[regexp {^( *).+◊tabl◊\t+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind addr]} {
  701.         set nextIndString [odbGetNextIndString $ind]
  702.         set nextLineText [getText [nextLineStart $curLineStart] [nextLineStart [nextLineStart $curLineStart]]]
  703.         if {![regexp "^$nextIndString" $nextLineText junk]} {
  704.             
  705.             set cells [frontierDoAlphaScript "Alpha.getCellData(@$addr)"]
  706.             odbBrowserAddCells $curLineEnd $cells [odbGetIndLevel $nextIndString]
  707.             
  708.         }
  709.     }
  710.     
  711.     select $curLineStart $curLineEnd
  712. }
  713.  
  714. proc odbBrowseLeft {} {
  715.     set curPos [getPos]
  716.     set curLineStart [lineStart $curPos]
  717.     set curLineEnd [nextLineStart $curPos]
  718.     
  719.     if {[regexp {^( *).+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind elems]} {
  720.         set pos [nextLineStart $curLineStart]
  721.         set start $pos
  722.         set nextIndString [odbGetNextIndString $ind]
  723.         while {[regexp "^$nextIndString" [getText $pos [nextLineStart $pos]] junk]} {
  724.             set pos [nextLineStart $pos]
  725.         }
  726.         setWinInfo read-only 0
  727.         deleteText $start $pos
  728.         setWinInfo dirty 0
  729.         setWinInfo read-only 1
  730.     }
  731.     select $curLineStart $curLineEnd
  732. }
  733.  
  734. proc odbBrowseEditObj {} {
  735.     set curPos [getPos]
  736.     set curLineStart [lineStart $curPos]
  737.     set curLineEnd [nextLineStart $curPos]
  738.     
  739.     if {[regexp {^.+∞(.+)∞} [getText $curLineStart $curLineEnd] junk addr]} {
  740.         frontierDoAlphaScript "Alpha.editCell(@$addr)"
  741.     }
  742. }
  743.  
  744. proc odbBrowse {{addr root}} {
  745.     if {$addr == ""} {
  746.         return
  747.     }
  748.     
  749.     global odbBrowserTypeOffset
  750.     global odbBrowserTabLength
  751.     
  752.     set cell [frontierDoAlphaScript "Alpha.getCellData(@$addr, false)"]
  753.     set wtitle [lindex [lindex $cell 0] 2]
  754.     regsub -all {[][]} $wtitle "" wtitle
  755.     set wtitle "* Frontier “$wtitle” *"
  756.     
  757.     if {[lsearch [winNames] $wtitle] >= 0} {
  758.         bringToFront $wtitle
  759.     } else {
  760.         new -n $wtitle -g 4 42 449 300 -m Odb
  761.         setWinInfo dirty 0
  762.         odbBrowserAddCells 0 $cell 0
  763.         select 0 [nextLineStart 0]
  764.         odbBrowseRight
  765.     }
  766. }
  767.  
  768. bind '\r'        odbBrowseEditObj    Odb
  769. bind enter        odbBrowseEditObj    Odb
  770.  
  771. bind down         odbBrowseDown        Odb
  772. bind down <c>    odbBrowseCmdDown    Odb
  773. bind down <co>    {odbBrowseCmdDown 1}    Odb
  774. bind up            odbBrowseUp            Odb
  775. bind up <c>        odbBrowseCmdUp        Odb
  776. bind up <co>    {odbBrowseCmdUp 1}        Odb
  777. bind right        odbBrowseRight        Odb
  778. bind left        odbBrowseLeft        Odb
  779.  
  780. if {![info exists frontierVersion] || $frontierVersion != 2.1} {
  781.     dialog -w 400 -h 180 -t "Welcome to Frontier menu 2.1.1" 70 10 390 30 \
  782.       -t "Make sure you install all the scripts in the folder 'Frontier verbs' into Frontier.\r\
  783.       If you upgrade from a previous version make sure you install the Frontier verbs which have been updated.\r\
  784.       You find information in the file 'Frontier Help'." 10 50 390 135 \
  785.       -b OK 20 150 85 170
  786.     catch {edit -r -c "$HOME:Help:Frontier Help"}
  787.     addDef frontierVersion 2.1
  788.     set frontierHasWarned 1
  789. }
  790.  
  791.  
  792. catch {frontierBuildScriptMenu}
  793. catch {unset frontierHasWarned}
  794.